Y5VERSION = 3.00(Courier New, 1, 11, 9, 17, 12, 10, 5, 0 vcrPixels/..\..\..\..\..\..\vfp\samples\solution\next.bmp containerClassWidth = 267 Height = 31 BackStyle = 0 BorderWidth = 0 BackColor = 192,192,192 skiptable = enabledisableoninit = .T. Name = "vcr"  DPROCEDURE recordpointermoved IF TYPE('_VFP.ActiveForm') = 'O' _VFP.ActiveForm.Refresh ENDIF ENDPROC PROCEDURE enabledisablebuttons LOCAL nRec, nTop, nBottom IF EOF() && Table empty or no records match a filter THIS.SetAll("Enabled", .F.) RETURN ENDIF nRec = RECNO() GO TOP nTop = RECNO() GO BOTTOM nBottom = RECNO() GO nRec DO CASE CASE nRec = nTop THIS.cmdTop.Enabled = .F. THIS.cmdPrior.Enabled = .F. THIS.cmdNext.Enabled = .T. THIS.cmdBottom.Enabled = .T. CASE nRec = nBottom THIS.cmdTop.Enabled = .T. THIS.cmdPrior.Enabled = .T. THIS.cmdNext.Enabled = .F. THIS.cmdBottom.Enabled = .F. OTHERWISE THIS.SetAll("Enabled", .T.) ENDCASE ENDPROC PROCEDURE beforerecordpointermoved IF !EMPTY(This.SkipTable) SELECT (This.SkipTable) ENDIF ENDPROC PROCEDURE Error Parameters nError, cMethod, nLine #define NUM_LOC "Error Number: " #define PROG_LOC "Procedure: " #define MSG_LOC "Error Message: " #define CR_LOC CHR(13) #define SELTABLE_LOC "Select Table:" #define OPEN_LOC "Open" #define SAVE_LOC "Do you want to save your changes anyway?" #define CONFLICT_LOC "Unable to resolve data conflict." DO CASE CASE nError = 13 && Alias not found *----------------------------------------------------------- * If the user tries to move the record pointer when no * table is open or when an invalid SkipTable property has been * specified, prompt the user for a table to open. *----------------------------------------------------------- cNewTable = GETFILE('DBF', SELTABLE_LOC, OPEN_LOC) IF FILE(cNewTable) SELECT 0 USE (cNewTable) This.SkipTable = ALIAS() ELSE This.SkipTable = "" ENDIF CASE nError = 1585 *----------------------------------------------------------- * Update conflict handled by datachecker class. *----------------------------------------------------------- nConflictStatus = THIS.DataChecker1.CheckConflicts() IF nConflictStatus = 2 WAIT WINDOW CONFLICT_LOC ENDIF OTHERWISE *----------------------------------------------------------- * Display information about an unanticipated error. *----------------------------------------------------------- lcMsg = NUM_LOC + ALLTRIM(STR(nError)) + CR_LOC + CR_LOC + ; MSG_LOC + MESSAGE( )+ CR_LOC + CR_LOC + ; PROG_LOC + PROGRAM(1) lnAnswer = MESSAGEBOX(lcMsg, 2+48+512) DO CASE CASE lnAnswer = 3 &&Abort CANCEL CASE lnAnswer = 4 &&Retry RETRY OTHERWISE RETURN ENDCASE ENDCASE ENDPROC PROCEDURE Init IF THIS.EnableDisableOnInit THIS.EnableDisableButtons ENDIF ENDPROC  %@ .U/ #6  UTHISPARENTBEFORERECORDPOINTERMOVEDENABLEDISABLEBUTTONSRECORDPOINTERMOVED.4CUNERRORCMETHODNLINETHISPARENTERRORClick,Error1R21 ) %)_ GUH  H %C+'#6  UTHISPARENTBEFORERECORDPOINTERMOVEDRECORDPOINTERMOVEDENABLEDISABLEBUTTONS.4CUNERRORCMETHODNLINETHISPARENTERRORClick,Error1QA31  ) %*` HUI  H %C(#)  UTHISPARENTBEFORERECORDPOINTERMOVEDRECORDPOINTERMOVEDENABLEDISABLEBUTTONS.4CUNERRORCMETHODNLINETHISPARENTERRORClick,Error1QA31  )1..\..\..\..\..\..\vfp\samples\classes\checker.bmp1..\..\..\..\..\..\vfp\samples\classes\checker.bmpmanages conflictsClass1custom datachecker/Height = 15 Width = 23 Name = "datachecker"  datacheckercustomPixels6vcrskiptable The table to move the record pointer in . enabledisableoninit *recordpointermoved Method called each time the record pointer is moved, basically providing a new event for the class. *enabledisablebuttons *beforerecordpointermoved  commandbutton commandbuttoncmdTopvcrTop = 4 Left = 12 Height = 24 Width = 48 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = "|<" TabIndex = 1 ToolTipText = "Top" Name = "cmdTop" PROCEDURE Click THIS.Parent.BeforeRecordPointerMoved GO TOP THIS.Parent.RecordPointerMoved THIS.Parent.EnableDisableButtons ENDPROC PROCEDURE Error Parameters nError, cMethod, nLine This.Parent.Error(nError, cMethod, nLine) ENDPROC  %@ .U/ #)  UTHISPARENTBEFORERECORDPOINTERMOVEDRECORDPOINTERMOVEDENABLEDISABLEBUTTONS.4CUNERRORCMETHODNLINETHISPARENTERRORClick,Error1R31 ) commandbutton commandbuttoncmdPriorvcrTop = 4 Left = 73 Height = 24 Width = 48 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = "<" TabIndex = 2 ToolTipText = "Prior" Name = "cmdPrior" PROCEDURE Click THIS.Parent.BeforeRecordPointerMoved SKIP -1 IF BOF() GO TOP ENDIF THIS.Parent.RecordPointerMoved THIS.Parent.EnableDisableButtons ENDPROC PROCEDURE Error Parameters nError, cMethod, nLine This.Parent.Error(nError, cMethod, nLine) ENDPROC /..\..\..\..\..\..\vfp\samples\solution\next.bmpgeneric vcr buttons container-Top = 12 Left = 179 Name = "Datachecker2" vcr Datachecker2custom donation.vcx datacheckerTop = 4 Left = 195 Height = 24 Width = 48 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = ">|" TabIndex = 4 ToolTipText = "Bottom" Name = "cmdBottom" vcr cmdBottom commandbutton commandbutton commandbuttoncmdNextvcrTop = 4 Left = 134 Height = 24 Width = 48 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = ">" TabIndex = 3 ToolTipText = "Next" Name = "cmdNext" PROCEDURE Click THIS.Parent.BeforeRecordPointerMoved SKIP 1 IF EOF() GO BOTTOM ENDIF THIS.Parent.RecordPointerMoved THIS.Parent.EnableDisableButtons ENDPROC PROCEDURE Error Parameters nError, cMethod, nLine This.Parent.Error(nError, cMethod, nLine) ENDPROC PROCEDURE Click THIS.Parent.BeforeRecordPointerMoved GO BOTTOM THIS.Parent.EnableDisableButtons THIS.Parent.RecordPointerMoved ENDPROC PROCEDURE Error Parameters nError, cMethod, nLine This.Parent.Error(nError, cMethod, nLine) ENDPROC  commandbutton!PROCEDURE handlerecord *---------------------------------------------------------------* * This method is called from the CheckConflicts method and the * VerifyEachChange method. It loops through each field in the * current record and compares the current value with the value * stored in the table. If a value of 1 is passed to this method, * the method also compares the current value with the value in * the field before user made any edits. * * RETURNS NUMERIC VALUES: * 0 -- No Change Made to the Current Value * 1 -- Successfully Made User-Specified Change * 2 -- Unable to Make User-Specifed Change *---------------------------------------------------------------* LPARAMETERS lnScope *--Valid values for lnScope: * 0 - Only manage conflicts && default * 1 - Also prompt for changed values * Verify parameter IF TYPE("m.lnScope") != "N" m.lnScope = 0 ENDIF IF !BETWEEN(m.lnScope, 0, 1) #define WINDMSG_LOC "Invalid value passed to conflictmanager.handlerecord" WAIT WINDOW WINDMSG_LOC ENDIF * Declare constants & variables #define CR_LOC CHR(13) #define SAVE_LOC "Do you want to overwrite the current value with your change?" + CR_LOC + "(Choose 'Cancel' to restore the original value.)" #define CONFLICT_LOC "Data Conflict" #define VERIFY_LOC "Verify Changes" #define ORG_LOC "Original Value: " #define CUR_LOC "Current Value: " #define CHG_LOC "Your change: " #define MEMO_LOC " is a Memo field." #define FIELD_LOC "Field: " #define RECORD_LOC "Record Number: " #define VALCHG1_LOC "A value has been changed by another user." #define VALCHG2_LOC "A value has been changed." LOCAL lnChoice, lnField, lcField, luOldVal, luCurVal, luField, llMadeChange, llSuccess m.llMadeChange = .F. m.llSuccess = .T. * refresh current record in views before checking for conflicts IF CURSORGETPROP('SourceType') != 3 && not a local table =REFRESH() ENDIF * Check each field in the record for conflict or value change FOR m.lnField = 1 to FCOUNT() m.lnChoice = 0 m.lcField = FIELD(m.lnField) IF TYPE(m.lcField) = "G" LOOP && Can't check general fields ENDIF m.luOldVal = OLDVAL(m.lcField) m.luCurVal = CURVAL(m.lcField) DO CASE * -----< check for conflicts only >-------- CASE m.lnScope = 0 IF m.luOldVal != m.luCurVal m.llMadeChange = .T. m.lnChoice = MESSAGEBOX(VALCHG1_LOC + CR_LOC + FIELD_LOC + lcField + CR_LOC + ; RECORD_LOC + ALLTRIM(STR(RECNO())) + ; IIF(TYPE("m.lcField") != "M", CR_LOC + CR_LOC + ORG_LOC + THIS.String(m.luOldVal) + ; CR_LOC + CUR_LOC + THIS.String(m.luCurVal) + ; CR_LOC + CHG_LOC + THIS.String(EVAL(m.lcField)), CR_LOC + CR_LOC + m.lcField + MEMO_LOC) + ; CR_LOC + CR_LOC + SAVE_LOC, + 3+48+0, CONFLICT_LOC) ENDIF * -----< check for conflicts and verify all changes >-------- CASE m.lnScope = 1 && Verify all changes m.luField = EVAL(m.lcField) IF m.luOldVal != m.luField OR m.luCurVal != m.luField m.llMadeChange = .T. m.lnChoice = MESSAGEBOX(VALCHG2_LOC + CR_LOC + FIELD_LOC + m.lcField + CR_LOC + ; RECORD_LOC + ALLTRIM(STR(RECNO())) + ; IIF(TYPE("m.lcField") != "M", CR_LOC + CR_LOC + ORG_LOC + THIS.String(m.luOldVal) + ; CR_LOC + CUR_LOC + THIS.String(m.luCurVal) + ; CR_LOC + CHG_LOC + THIS.String(EVAL(m.lcField)), CR_LOC + CR_LOC + m.lcField + MEMO_LOC) + ; CR_LOC + CR_LOC + SAVE_LOC, + 3+48+0, VERIFY_LOC) ENDIF ENDCASE DO CASE CASE m.lnChoice = 7 && No, don't save changes REPLACE (m.lcField) WITH m.luCurVal CASE m.lnChoice = 2 && Cancel, restore original value REPLACE (m.lcField) WITH m.luOldVal ENDCASE ENDFOR IF m.llMadeChange m.llSuccess = TABLEUPDATE(.F., .T.) RETURN IIF(m.llSuccess, 1, 2) ELSE RETURN 0 ENDIF ENDPROC PROCEDURE string *---------------------------------------------------------------* * This method is called from the HandleRecord method. It * returns the character equivalent of the value passed in as a * parameter. If a memo field is passed in, a notice to this * effect is returned rather than the value in the memo field so * that potentially large amounts of text aren't displayed in the * messagebox. *---------------------------------------------------------------* LPARAMETERS luValue m.uType = TYPE('m.luValue') DO CASE CASE m.uType = 'C' RETURN ALLTRIM(m.luValue) CASE INLIST(m.uType, 'N', 'Y') RETURN ALLTRIM(STR(m.luValue)) CASE m.uType = 'D' RETURN DTOC(m.luValue) CASE m.uType = 'T' RETURN TTOC('m.luValue') CASE m.uType = 'L' RETURN IIF(m.luValue, '.T.', '.F.') CASE uType = 'M' RETURN 'Memo field' ENDCASE ENDPROC PROCEDURE verifychanges *---------------------------------------------------------------* * If any changes have been made to the table or record, prompt the * user to save the changes. If the user says 'yes,' all changes * are saved. Any changes made to the data by other users after * this user made the change and before the change was committed * will be lost. * * RETURNS NUMERIC VALUES: * 0 -- No Changes Made to the Current Values * 1 -- Successfully Made All User Changes * 2 -- Unable to Write One or More User-Specifed Changes to Table *---------------------------------------------------------------* * Declare constants & variables #define SAVECHG_LOC 'Do you want to save your changes?' #define SAVECHG2_LOC 'Save Changes' #define NOBUFF_LOC2 'Data buffering is not enabled.' LOCAL lnChoice, llMadeChange, lnSuccess m.llMadeChange = .F. m.lnSuccess = 0 * If the user has changed anything, prompt to save or discard changes DO CASE CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering IF '2' $ GETFLDSTATE(-1) m.llMadeChange = .T. ENDIF CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering IF GETNEXTMODIFIED(0) > 0 m.llMadeChange = .T. ENDIF OTHERWISE WAIT WINDOW NOBUFF_LOC NOWAIT ENDCASE IF m.llMadeChange m.lnChoice = MESSAGEBOX(SAVECHG_LOC, 4+32, SAVECHG2_LOC) IF m.lnChoice = 6 && Yes m.lnSuccess = IIF(TABLEUPDATE(.T.,.T.), 1, 2) ELSE =TABLEREVERT(.T.) ENDIF ENDIF RETURN m.lnSuccess ENDPROC PROCEDURE verifyeachchange *-------------------------------------------------------------------- * If any changes have been made to the table or record, for each * change, display the old value and the new value, prompting the * user to save or discard the change. Conflict management is also * included in the HandleRecord method. * * RETURNS NUMERIC VALUES: * 0 -- No Changes Made to the Current Values * 1 -- Successfully Made User-Specified Changes * 2 -- Unable to Write One or More User-Specifed Changes to Table *---------------------------------------------------------------* #define NOBUFF_LOC3 'Data buffering is not enabled.' LOCAL lnSuccess, lnRec m.lnSuccess = 0 DO CASE CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering IF '2' $ GETFLDSTATE(-1) && Data has changed m.lnSuccess = THIS.HandleRecord(1) ENDIF CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering m.lnRec = GETNEXTMODIFIED(0) DO WHILE m.lnRec > 0 GO m.lnRec m.lnSuccess = IIF(m.lnSuccess != 2, THIS.HandleRecord(1), 2) m.lnRec = GETNEXTMODIFIED(m.lnRec) ENDDO OTHERWISE && No Buffering WAIT WINDOW NOBUFF_LOC NOWAIT ENDCASE RETURN m.lnSuccess ENDPROC PROCEDURE checkconflicts *---------------------------------------------------------------* * Checks to see whether another user has changed the value * stored in a table. If so, calls HandleRecord to display * the new value and allow the user to decide what to do. * * RETURNS NUMERIC VALUES: * 0 -- No Changes Made to the Current Values * 1 -- Successfully Made User-Specified Changes * 2 -- Unable to Make Write One or More User-Specifed Changes to Table *---------------------------------------------------------------* #define NOBUFF1_LOC 'Data buffering is not enabled.' LOCAL lnSuccess, llnRec m.lnSuccess = 0 DO CASE CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering IF '2' $ GETFLDSTATE(-1) && Data has changed m.lnSuccess = THIS.HandleRecord(0) ENDIF CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering m.llnRec = GETNEXTMODIFIED(0) DO WHILE m.llnRec > 0 GO m.llnRec m.lnSuccess = IIF(m.lnSuccess != 2, THIS.HandleRecord(0), 2) m.llnRec = GETNEXTMODIFIED(m.llnRec) ENDDO OTHERWISE && no buffering WAIT WINDOW NOBUFF_LOC NOWAIT ENDCASE RETURN m.lnSuccess ENDPROC  %  UO%C m.lnScopebN3T %C  >R,4Invalid value passed to conflictmanager.handlerecord# T - T a%C SourceType C (C.T T C /%C bGM.T C _T C  H %   T aT C)A value has been changed by another user.C Field: C Record Number: CCCOZCC m.lcFieldbM}C C Original Value: C  C Current Value: C  C  Your change: CC  &C C   is a Memo field.6C C <Do you want to overwrite the current value with your change?C 0(Choose 'Cancel' to restore the original value.)3 Data Conflictx T C $%      T aT CA value has been changed.C Field:  C Record Number: CCCOZCC m.lcFieldbM}C C Original Value: C  C Current Value: C  C  Your change: CC  &C C   is a Memo field.6C C <Do you want to overwrite the current value with your change?C 0(Choose 'Cancel' to restore the original value.)3Verify Changesx H >   >  % 7T C-aBC 6H BU LNSCOPELNCHOICELNFIELDLCFIELDLUOLDVALLUCURVALLUFIELD LLMADECHANGE LLSUCCESSTHISSTRING T C m.luValueb H. CO BC  C NYwBCC Z D BC * TBC m.luValue LBC .T..F.6 MB Memo fieldULUVALUEUTYPE T -T  H8! CC Buffering%2C| T a! CC Buffering%C T a2 R,:% yET C!Do you want to save your changes?$ Save Changesx% cT CCaa6u Ca B ULNCHOICE LLMADECHANGE LNSUCCESS NOBUFF_LOC1 T  H'! CC Bufferingx%2CtT C! CC Buffering T C+  # *T C  C6T C 2 R,: B U LNSUCCESSLNRECTHIS HANDLERECORD NOBUFF_LOC1 T  H'! CC Bufferingx%2CtT C! CC Buffering T C+  # *T C  C6T C 2 R,: B U LNSUCCESSLLNRECTHIS HANDLERECORD NOBUFF_LOC handlerecord,string verifychangesverifyeachchange checkconflictsA 1AA1A2aAAAA2QVA21AAA1A1AAAA3zAAAQA!1A2 aAAAAQ1AA2aaA!AAAA2aaA!AAAA12WiC{K]r%pJ!)*handlerecord compares the current value, old value, and original value of each field, displaying a messagebox if a change or conflict is detected. *string returns type 'c' equivalent of passed value *verifychanges Prompts a user to save all changes made to a table or record. *verifyeachchange Prompts a user to confirm each change he or she made. *checkconflicts Notifies a user if someone else has changed the data in the table after he or she began editing a record.  %D{U6#%C_VFP.ActiveFormbO/ CU ACTIVEFORMREFRESHP %C+7CEnabled-B TCO#) TCO#6 TCO # HI T-T-TaT a )TaTaT-T -2ICEnabledaU NRECNTOPNBOTTOMTHISSETALLCMDTOPENABLEDCMDPRIORCMDNEXT CMDBOTTOM'%C  FUTHIS SKIPTABLE4 H  )TCDBF Select Table:Open%C0F QTCT 1TC%*R, Unable to resolve data conflict.2fT Error Number: CCZC C Error Message: CEC C  Procedure: CtT C 2x H   X2BU NERRORCMETHODNLINE CNEWTABLETHIS SKIPTABLENCONFLICTSTATUS DATACHECKER1CHECKCONFLICTSLCMSGLNANSWER!% UTHISENABLEDISABLEONINITENABLEDISABLEBUTTONSrecordpointermoved,enabledisablebuttons{beforerecordpointermoved!Error]Init11A3AAQQA21A3A!DAfAAAAAA3A1a!$#= *@ 9 _)